В этом модуле мы будем использовать библиотеку ggplot2 и plotly для создания интерактивной карты расстановки игроков на поле.
Функция отвечающая за отрисовку называется plot_scene. Она принимает в качестве аргументов:
датасеты с координатами двух команд (offense_df и defense_df)
координата x для мяча - ball_x
координата y для мяча - ball_y
заголовок графика - title
Для отрисовки создается поле с разделенными по 10 ярдов зонами, двумя зонами тачдауна для каждой команды и линией положения мяча. В NFL используется игровое поле размером 100 на 53 ярда. Для предотврацения выхода за границы поле в функции ограничено - вылетающие значения обрезаются.
plot_scene <- function(offense_df, defense_df, ball_x, ball_y, title) {
if (ball_x > 109){
ball_x = 109
}
if(ball_x < 11){
ball_x = 11
}
if (ball_y > 52){
ball_y = 52
}
if(ball_y < 1){
ball_y = 1
}
offense_df['role'] = 'offense'
defense_df['role'] = 'defense'
n_df <- rbind(offense_df, defense_df)
ball <- data.frame(x=0, y=0, density=0, type='', Atype=0, role='ball')
n_df <- rbind(n_df, ball)
n_df$role <- as.factor(n_df$role)
plt <- ggplot(n_df) +
annotate("rect", xmin=0, xmax=10, ymin=0, ymax=53, fill='red', alpha=.2) +
annotate("rect", xmin=110, xmax=120, ymin=0, ymax=53, fill='red', alpha=.2) +
annotate("rect", xmin=10, xmax=110, ymin=0, ymax=53, fill='green', alpha=.2) +
xlim(0, 120) + ylim(0, 53) +
geom_vline(xintercept=seq(0, 120, 10)) +
geom_vline(xintercept=ball_x, colour='red') +
geom_hline(yintercept=seq(0, 53, 53)) +
geom_point(mapping=aes(x+ball_x, y+ball_y, colour=role), size=3) +
geom_text(mapping=aes(x+ball_x, y+ball_y, label=type), size=2.5) +
ggtitle(title) +
xlab("X") +
ylab("Y") +
labs(colour="Team") +
scale_color_manual(values=c("#32CD32", "#6495ED", "#F08080"))
ggplotly(plt)
}
Для моделирования положения игроков на поле используются данные
add_missing <- function(df, cur_max) {
if(nrow(df) < cur_max){
diff = cur_max - nrow(df)
for (i in 1:diff) {
dx = runif(1,0,1)
dy = runif(1,-5,5)
new <- list(x=df[i,]$x + dx, y=df[i,]$y + dy, density=df[i,]$density, type=df[i,]$type, Atype=df[i,]$Atype)
df <- rbind(df, new)
}
} else {
df <- df[1:cur_max,]
}
return(df)
}
Функция создания набора позиций по формации
formation_make <- function(type=0, formation) {
bestper <- read.csv("bestper.csv")
bestpossDef <- read.csv("bestpossDef.csv")
bestpossDef <- bestpossDef[bestpossDef$density != 0,]
bestpossA <- read.csv("bestpossA.csv")
bestpossA <- bestpossA[bestpossA$density != 0,]
if(type == 0){
current <- bestper[bestper$offenseFormation == formation,]
all_pos <- bestpossDef[bestpossDef$Atype == formation,]
dl_pos <- all_pos[all_pos$type == 'DL',]
if(nrow(dl_pos) == 0){
dl_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'DL',]
}
lb_pos <- all_pos[all_pos$type == 'LB',]
if(nrow(lb_pos) == 0){
lb_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'LB',]
}
db_pos <- all_pos[all_pos$type == 'DB',]
if(nrow(db_pos) == 0){
db_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'DB',]
}
dl_pos <- add_missing(dl_pos, current$DL_def)
lb_pos <- add_missing(lb_pos, current$LB_def)
db_pos <- add_missing(db_pos, current$DB_def)
field_df <- rbind(dl_pos, lb_pos, db_pos)
} else {
field_df <- bestpossA[bestpossA$Atype == formation,]
if(nrow(field_df) > 10){
field_df <- field_df[1:10,]
}
}
return(field_df)
}
В качестве положений мяча будут координаты (75, 35), (100, 43), (34, 30)
l <- htmltools::tagList()
i = 1
for (form in c("ALL", "I_FORM", "JUMBO", "PISTOL", "SHOTGUN", "SINGLEBACK", "WILDCAT")) {
def_df <- formation_make(type=0, formation = form)
off_df <- formation_make(type=1, formation = form)
l[[i]] <- as.widget(plot_scene(off_df, def_df, runif(1,5,105), runif(1, 10, 43), paste("Моделирование игры NFL -", form)))
i = i+1
}
l